home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Business Master (3rd Edition)
/
The Business Master (3rd Edition).iso
/
files
/
utilhive
/
lharc114
/
lzip13.bas
< prev
next >
Wrap
BASIC Source File
|
1989-03-11
|
15KB
|
400 lines
' $title:'LZIP - Attempt to make the Littlest ZIP file' $pagesize:74 $linesize:132
' by S. David Klein, version 1.3, 3/11/89
' derived from LARC version 1.6 by Vernon D. Buerg, used with permission
'
' Purpose:
' - make the smallest ZIP files possible
' - learn how the ADVBAS subroutines work
' - evaluate compression efficiency of ZIP options
' - convert all ARC files to the smallest ZIP files possible
'
' Usage:
' LZIP13 d:[\path\]filespec [d:\outpath] [/R] [/F]
'
' The input file specification is required and specifies the
' location of ZIP files to be processed. The path name is optional.
'
' You MUST not have the input dir as the current dir. The current
' drive (and directory) is used for temporary work space. Each
' ZIP file is extracted to the current directory.
'
' If the processed ZIP file is smaller, the original ZIP file
' is replaced. The file's date and time are preserved.
'
' You must have ARCE, PKZIP and PKUNZIP accessible from the DOS path;
' PKZIP must be version 0.92 which supports the -ex option
' if you have changed the names of the .EXE files, make the necessary
' changes in this source and compile/link (QB 4.5):
' BC LZIP13 /D/E/O;
' LINK LZIP13,,,ADVBAS;
'
' Options:
' /R specifies that a summary report is produced in the file LZIP.RPT.
' /F specifies that the first ZIP created will replace the original file;
' this is useful when adding a comment or replacing all ARC files.
'
' ==========================================================================
' Definitions
defint a-z : maxfiles = 512
dim arc$(maxfiles) ' filenames and stats for later
dim method$(3) ' up to three methods used
dim savings(3) ' total bytes saved per method
version$="LZIP Version 1.3" ' some internal signs
author$="by S. David Klein"
false = 0 : true = not false
cluster = 512 ' target disk cluster size
' $dynamic
dim before!(maxfiles) ' original file sizes
dim after!(maxfiles,3) ' sizes after each method
dim stamp(maxfiles,6) ' file mo,dy,yr;hr,min,sec
' $static
def fneat$(x!) ' neaten number displays
fneat$ = right$(space$(8)+str$(x!),8)
end def
def fn ltrim$(x$) ' trim leading blanks
while left$(x$,1)=" "
x$=mid$(x$,2)
wend
fn ltrim$ = x$
end def
def fn rtrim$(x$) ' trim trailing blanks
while right$(x$,1)=" "
x$=left$(x$,len(x$)-1)
wend
fn rtrim$ = x$
end def
def fn trim$(x$) ' trim left and right blanks
fn trim$ = fn rtrim$(fn ltrim$(x$))
end def
def fn switch (x$) ' process option switches
if instr(parm$,x$) _
then fn switch = true : _
mid$(parm$,instr(parm$,x$),2)=" " _
else fn switch = false
end def
' $page $subtitle: 'Initialization'
' =============================================================================
initialize:
on error goto err.traps
call getdosv(majorv,minorv) ' check dos version
if majorv<3 then print "Incorrect DOS version." : end
parm$=command$ ' command parameters and options
swr = fn switch ("/R") ' produce LZIP.RPT
swf = fn switch ("/F") ' force ZIP replacement
swa=true ' use the -aex option of PKZIP 0.92
method=1 ' index to method name
method$(method)="A"
' get input file d:\path\filename
if instr(parm$," ") _ ' and output drive:\path
then infile$ = fn trim$(left$(parm$,instr(parm$," ")-1)) : _
outpath$ = fn trim$(mid$(parm$,instr(parm$," ")+1)) _
else infile$ = fn trim$(parm$) : _
outpath$ = ""
if infile$="" then print "Input filespec missing!" : end
if instr(infile$,".")=0 then infile$=infile$+".ZIP"
in.drive$=" " ' get drive letter of original files
if mid$(infile$,2,1) = ":" _
then in.drive$=left$(infile$,1) : _
infile$=mid$(infile$,3) _
else print "You must supply the input drive letter!" : _
end
call drvspace (in.drive$,a,b,c) ' initial free space on source drive
before.space! = csng(a)*csng(b)*csng(c)
cluster = a * 512 ' target disk cluster size
inpath$="" ' get input drive and path names
for i=len(infile$) to 1 step -1 'altered this section 12/26/88
if mid$(infile$,i,1)="\" then 'to work with QB 4.5, since the
inpath$=left$(infile$,i) 'ELSE NEXT structure seemed not
infile$=mid$(infile$,i+1) 'to work. This seems to do the
end if 'job.
next
temp.drive$=" " ' make sure different drives\paths
call getdrv(temp.drive$) ' for temp, input, and output
temp.path$=string$(64,0) ' temporary d:\path
call getsub (temp.path$,tlen)
temp.path$="\"+left$(temp.path$,tlen)+"\"
temp.file$=temp.drive$+":"+left$(temp.path$,len(temp.path$)-1)
call findfirstf ("*.*"+chr$(0),0,retcd) ' insure temp is empty
if (temp.drive$ = in.drive$ and temp.path$=inpath$) _
or outpath$ = temp.file$ _
or retcd = 0 _
then
print "Input path: ";in.drive$+":"+inpath$
print "Output path: ";outpath$
print "Temp path: ";temp.file$
print
print "You must use a different d:\path for the original input files,"
print "and the output destination drive and path; other than the"
print "current directory used for the temporary work files!"
print "The temporary directory must be empty."
end
end if
' $page $subtitle: 'Mainline'
' =============================================================================
mainline:
attr = 0 : retcd=0 ' get first file name
arcname$=in.drive$+":"+inpath$+infile$ ' from original filespec
call findfirstf (arcname$+chr$(0),attr,retcd)
if retcd then
print "No matching files found for ";arcname$
end
end if
' Build table of files to process
get.file: ' extract next file name
infile$=space$(12)
call getnamef (infile$,flen)
if flen <0 _
then print "GETNAMEF logical error." : end _
else infile$=left$(infile$,flen)
if numfiles < maxfiles _ ' save data for report
then numfiles=numfiles+1
call getdatef(month,day,year) ' preserve datestamp
stamp(numfiles,1)=month
stamp(numfiles,2)=day
stamp(numfiles,3)=year
call gettimef(hour,minute,second)
stamp(numfiles,4)=hour
stamp(numfiles,5)=minute
stamp(numfiles,6)=second
call getsizef(lo,hi) ' original file size
lo!=csng(lo)
if lo<0 then lo!=lo!+65536!
insize!=lo!+csng(hi)*65536!
arc$(numfiles)=infile$
before!(numfiles)=insize!
for method=1 to 3
after!(numfiles,method)=insize!
next method
call findnextf (retcd) ' next file to process
if retcd=0 then goto get.file
' $page $subtitle:'Invoke ARC processors for each archive file'
' ----------------------------------------------------------------
process:
100 for filenum=1 to numfiles
infile$=arc$(filenum) ' original file name
insize!=before!(filenum) ' and file size
before!=insize!
arcname$=in.drive$+":"+inpath$+infile$ ' complete original filespec
outfile$=infile$ ' form target file name
if instr(infile$,".ARC") _
then mid$(outfile$,instr(infile$,".ARC"),4)=".ZIP"
120 method = 0 ' index for method used to ZIP
'if insize!<cluster then ' skip small files?
' for s=1 to 3 ' commented out to force all
' after!(filenum,s)=insize! ' files to be processed
' next
' if outpath$ = "" _ ' unless copying all ZIP files
' then goto next.file
'end if
replaced=copies ' times file has been copied
if instr(arcname$,".ARC") _ ' extract the file
then cmd$="arce "+arcname$ _
else cmd$="pkunzip "+arcname$
cls : color 15,0 : print cmd$ : color 7,0
shell cmd$
if swa then
cmd$="pkzip -aex "+outfile$+" *.*" ' make the smallest ZIP
' some variations on the theme-
' to add a comment, use this example
'cmd$="pkzip -azex "+outfile$+" *.* < comment.txt where comment.txt
' contains the comment to be added
cls : color 15,0 : print cmd$ : color 7,0
shell cmd$
gosub evaluate
end if
if okay then kill "*.*" ' rid extracted files
if outpath$<>"" and replaced=copies then ' did not copy it yet?
cmd$ = "copy "+arcname$+" "+outpath$ ' do it now
cls : color 15,0 : print cmd$ : color 7,0
shell cmd$
copies = copies + 1
end if
if instr(arcname$,".ARC") and replaced<>copies and outpath$="" _
then kill arcname$ ' delete original ARC file
next.file:
next filenum
' $page $subtitle: 'Display file statistics'
' =============================================================================
report:
200 if swr _
then rptname$="lzip.rpt" _
else rptname$="scrn:"
open rptname$ for output as #1
beep ' wake em up
if okay =0 _ ' something broke
then locate 24,1 : _
print "Aborted due to Error or ESC keyin!" : _
print : _
gosub newpage _
else gosub heading
for i=1 to numfiles
if swr=0 and csrlin>22 then gosub newpage
print #1,arc$(i);tab(15); fneat$(before!(i));
for s=1 to method
after=int( (after!(i,s)+cluster-1)/cluster)
before=int( (before!(i)+cluster-1)/cluster)
savings = after-before
savings(s)=savings(s)+savings
print #1,fneat$(after!(i,s)); fneat$(csng(savings)*cluster);
next s
print #1,
next
if swr=0 and csrlin>12 then gosub newpage
print #1,copies;"file(s) replaced"; ' Sum of savings by method
print #1,tab(30);" ";
for s=1 to method
print #1,fneat$(csng(savings(s))*cluster);" ";
next
print #1,
call drvspace (in.drive$,a,b,c) ' get disk space saving
after.space! = csng(a)*csng(b)*csng(c)
print #1,
print #1," Free disk space: "
print #1," before ";
print #1,using "##,###,###";before.space!
print #1," after ";
print #1,using "##,###,###";after.space!
print #1," saved ";after.space! - before.space!;"bytes"
close #1 ' all done
if swr then
open rptname$ for input as #1 ' display the report
while not eof (1) ' in addition to writing it to
line input #1,a$ ' the file to LZIP.RPT
print a$
wend
close #1
end if
end
newpage:
line input "Press ENTER to continue:";a$
heading:
cls ' pretty fancy, eh?
print #1,version$;" - Processing ";command$
print #1,
print #1,"Filename";tab(15);" before";
for s=1 to method
print #1," after";method$(s);" diff";
next
print #1,
locate ,1
return
' $page $subtitle: 'Evaluate results of re-ZIPing the files'
' ---------------------------------------------------------
evaluate:
okay = 0 ' indicates success or not
if inkey$ = chr$(27) then return report ' aborted by ESCape key
okay = 1
method = method + 1
300 open outfile$ for input as #2 ' get new file size
outsize!=lof(2)
close #2
310 after!(filenum,method)=outsize!
'after=int( (outsize!+cluster-1)/cluster) ' compute clusters saved
'before=int( (before!+cluster-1)/cluster)
savings! = outsize! - before! ' bytes (was clusters) saved
400 if savings! <0 or (outpath$<>"" and method=1) or swf then
call setftd(outfile$+chr$(0),stamp(filenum,1),stamp(filenum,2), _
stamp(filenum,3),stamp(filenum,4),stamp(filenum,5), _
stamp(filenum,6) ) ' preserve date stamp
if outpath$="" _ ' overlay original or to another subdir
then cmd$= "copy "+outfile$+" "+in.drive$+":"+inpath$+outfile$ _
else cmd$= "copy "+outfile$+" "+outpath$
cls : color 15,0 : print cmd$ : color 7,0
shell cmd$
before!=outsize! ' new original file size
copies=copies+1
end if
410 kill outfile$ ' rid the temporary file
copy.done:
return
copy.failed:
okay = 0
return report 'next.file ' file not found, not created, etc.
err.traps:
if erl=100 then print arcname$;" not found"
if erl=410 then resume copy.done ' short file only copied
if erl=300 then resume copy.failed ' no ZIP created
print "Error";err;"at line";erl
end